home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch12 / TwoD.bas < prev    next >
BASIC Source File  |  1999-06-17  |  4KB  |  120 lines
  1. Attribute VB_Name = "TwoDStuff"
  2. Option Explicit
  3.  
  4. Private m_OldPen As Long
  5. Private m_OldBrush As Long
  6. Private m_NewBrush As Long
  7. Private m_NewPen As Long
  8.  
  9. Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
  10. Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
  11. Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
  12. Private Declare Function CreateBrushIndirect Lib "gdi32" (lpLogBrush As LOGBRUSH) As Long
  13. Private Type LOGBRUSH
  14.     lbStyle As Long
  15.     lbColor As Long
  16.     lbHatch As Long
  17. End Type
  18.  
  19. Private Const BS_SOLID = 0
  20. Private Const BS_NULL = 1
  21. Private Const BS_HOLLOW = BS_NULL
  22. Private Const BS_HATCHED = 2
  23. Private Const HS_BDIAGONAL = 3
  24. Private Const HS_CROSS = 4
  25. Private Const HS_DIAGCROSS = 5
  26. Private Const HS_FDIAGONAL = 2
  27. Private Const HS_HORIZONTAL = 0
  28. Private Const HS_VERTICAL = 1
  29. ' Initialize default drawing properties.
  30. Public Sub InitializeDrawingProperties(ByVal obj As TwoDObject)
  31.     obj.DrawWidth = 1
  32.     obj.DrawStyle = vbSolid
  33.     obj.ForeColor = vbBlack
  34.     obj.FillColor = vbBlack
  35.     obj.FillStyle = vbFSTransparent
  36. End Sub
  37. ' Return the drawing property serialization
  38. ' for this object.
  39. Public Function DrawingPropertySerialization(ByVal obj As TwoDObject) As String
  40. Dim txt As String
  41.  
  42.     txt = txt & " DrawWidth(" & Format$(obj.DrawWidth) & ")"
  43.     txt = txt & " DrawStyle(" & Format$(obj.DrawStyle) & ")"
  44.     txt = txt & " ForeColor(" & Format$(obj.ForeColor) & ")"
  45.     txt = txt & " FillColor(" & Format$(obj.FillColor) & ")"
  46.     txt = txt & " FillStyle(" & Format$(obj.FillStyle) & ")"
  47.  
  48.     DrawingPropertySerialization = txt & vbCrLf & "    "
  49. End Function
  50.  
  51. ' Read the token name and value and to see
  52. ' if it is drawing property information.
  53. Public Sub ReadDrawingPropertySerialization(ByVal obj As TwoDObject, ByVal token_name As String, ByVal token_value As String)
  54.     Select Case token_name
  55.         Case "DrawWidth"
  56.             obj.DrawWidth = CInt(token_value)
  57.         Case "DrawStyle"
  58.             obj.DrawStyle = CInt(token_value)
  59.         Case "ForeColor"
  60.             obj.ForeColor = CLng(token_value)
  61.         Case "FillColor"
  62.             obj.FillColor = CLng(token_value)
  63.         Case "FillStyle"
  64.             obj.FillStyle = CInt(token_value)
  65.     End Select
  66. End Sub
  67.  
  68.  
  69. ' Set the drawing properties for the canvas.
  70. Public Sub SetCanvasDrawingParameters(ByVal obj As TwoDObject, ByVal canvas As Object)
  71.     canvas.DrawWidth = obj.DrawWidth
  72.     canvas.DrawStyle = obj.DrawStyle
  73.     canvas.ForeColor = obj.ForeColor
  74.     canvas.FillColor = obj.FillColor
  75.     canvas.FillStyle = obj.FillStyle
  76. End Sub
  77. ' Set the drawing properties for the metafile.
  78. Public Sub SetMetafileDrawingParameters(ByVal obj As TwoDObject, ByVal mf_dc As Long)
  79. Dim log_brush As LOGBRUSH
  80. Dim new_brush As Long
  81. Dim new_pen As Long
  82.  
  83.     With log_brush
  84.         If obj.FillStyle = vbFSTransparent Then
  85.             .lbStyle = BS_HOLLOW
  86.         ElseIf obj.FillStyle = vbFSSolid Then
  87.             .lbStyle = BS_SOLID
  88.         Else
  89.             .lbStyle = BS_HATCHED
  90.             Select Case obj.FillStyle
  91.                 Case vbCross
  92.                     .lbHatch = HS_CROSS
  93.                 Case vbDiagonalCross
  94.                     .lbHatch = HS_DIAGCROSS
  95.                 Case vbDownwardDiagonal
  96.                     .lbHatch = HS_BDIAGONAL
  97.                 Case vbHorizontalLine
  98.                     .lbHatch = HS_HORIZONTAL
  99.                 Case vbUpwardDiagonal
  100.                     .lbHatch = HS_FDIAGONAL
  101.                 Case vbVerticalLine
  102.                     .lbHatch = HS_VERTICAL
  103.             End Select
  104.         End If
  105.         .lbColor = obj.FillColor
  106.     End With
  107.  
  108.     m_NewPen = CreatePen(obj.DrawStyle, obj.DrawWidth, obj.ForeColor)
  109.     m_NewBrush = CreateBrushIndirect(log_brush)
  110.     m_OldPen = SelectObject(mf_dc, m_NewPen)
  111.     m_OldBrush = SelectObject(mf_dc, m_NewBrush)
  112. End Sub
  113. ' Restore the drawing properties for the metafile.
  114. Public Sub RestoreMetafileDrawingParameters(ByVal mf_dc As Long)
  115.     SelectObject mf_dc, m_OldBrush
  116.     SelectObject mf_dc, m_OldPen
  117.     DeleteObject m_NewBrush
  118.     DeleteObject m_NewPen
  119. End Sub
  120.